perm filename BES.SAI[1,MUS] blob
sn#080814 filedate 1974-01-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "FM" COMMENT BY GARY GOODMAN, JULY 1971
C00014 ENDMK
C⊗;
BEGIN "FM" COMMENT BY GARY GOODMAN, JULY 1971;
REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
INTEGER I,IIDEL,NI,L,R,LINE,K,DPY,DPY1,DPY2;
REAL C,MF,Z,W,MI1,MI2,BEAT,ZSAVE,MAXF,MINF,DELTAF,XFACT;
REAL SAVEC;
STRING S,CMD,SBARF;
BOOLEAN POWER,DEBUG,III,STEP_MODE,SOUND;
LABEL NEXT_SET;
DEFINE CRLF="('15&'12)", TIL="STEP 1 UNTIL", KMAX="33",
DELY="(-100)", DELX="(-510)", CHRWIDTH="3", CHRHEIGHT="14";
INTEGER ARRAY DPYBUF[1:200];
REAL ARRAY J[-KMAX:KMAX];
PROCEDURE BARF(BOOLEAN ECHO);
BEGIN INTEGER I,J; STRING S;
WHILE (I←PTCHRS(LINE))≠-1 DO IF DEBUG OR ECHO THEN OUTCHR(I);
END;
PROCEDURE INIT_PTY;
BEGIN
LINE←PTYGET;
START_CODE LABEL FIN,PTYSER,LOOP;
INTEGER ACTBIT,RETADR,SAVE0;
OWN INTEGER ARRAY FOO[0:'177];
EXTERNAL INTEGER JOBAPR,JOBTPC;
MOVEI PTYSER;
MOVEM JOBAPR;
MOVE LINE;
MOVEM FOO[0];
MOVSI '001000;
MOVEM ACTBIT;
INTMSK 1,ACTBIT;
CALLI '400025; COMMENT INTENB: Enable interrupt on
character in PTY buffer;
PPIOT 0;
PPIOT 2,'700;
PPIOT 3,'3003;
PPIOT 1;
PPIOT 1,'600000;
JRST FIN;
PTYSER: SETZ 0;
CALLI '400025; COMMENT INTENB: Turn off interrupts;
MOVEI FOO[2];
MOVEM FOO[1];
PTYUUO '10,@FOO; COMMENT PTRDS, This is done before UWAIT
in case we were waiting to stuff
something into PTY buffer!;
CALLI '400034; COMMENT UWAIT;
MOVE JOBTPC;
MOVEM RETADR;
CALLI '400035; COMMENT DEBREAK;
LOOP: MOVEM 0,SAVE0;
PPIOT 0;
TTCALL 3,FOO[2];
PPIOT 1;
PPIOT 1,'600000;
PTYUUO 3,@FOO;
MOVE 0,SAVE0;
SKIPN FOO[1];
INTUUO ACTBIT; COMMENT INTJEN;
MOVEI FOO[2];
MOVEM FOO[1];
PTYUUO '10,@FOO;
JRST LOOP;
FIN: END;
PTOSTR(LINE,
"L "&CVXSTR(CALL(0,"GETPPN"))[1 FOR 3]&"."&CVXSTR(CALL(0,"GETPPN"))[4 FOR 3]&"
"); PTOSTR(LINE,
"RUN GARY[JC,MUS] 17
TTY:
");
END;
PROCEDURE PLAYON;
BEGIN STRING S; INTEGER F;
BARF(TRUE);
OUTSTR("YOU ARE NOW TALKING TO MUS, TYPE E TO EXIT"&CRLF);
WHILE TRUE DO
BEGIN
WHILE TRUE DO
BEGIN
S←INCHSL(F);
IF F≠-1 THEN DONE;
CALL(1,"SLEEP");
END;
IF S='175 THEN
BEGIN
OUTSTR("<altmode>");
PTOCHS(LINE,'175);
IF LENGTH(S)>1 THEN PTOSTR(LINE,S[2 TO ∞]&CRLF);
END
ELSE IF S="E" THEN BEGIN
IF NOT DEBUG THEN DPYTYP(-430,5,1);
DONE;
END
ELSE PTOSTR(LINE,S&CRLF);
END;
END;
PROCEDURE PLAY1(REAL MI);
BEGIN STRING S;
S←"FM1 0 1 1500 "&CVS(C)&" "&CVF(MF)&" "&CVF(MI)&" "&CVF(MI)&" F8 F8;";
BARF(TRUE);
PTOSTR(LINE,"PLAY;"&S&"FINISH;"&CRLF);
PLAYON;
END;
PROCEDURE PLAY2;
BEGIN STRING S;
S←"FM1 0 1 1500 "&CVF(C)&" "&CVF(MF)&" "&CVF(MI1)&" "&CVF(MI2)&" F3 F3;";
BARF(TRUE);
PTOSTR(LINE,"PLAY;"&S&"FINISH;"&CRLF);
PLAYON;
END;
PROCEDURE ISOHZ(INTEGER M,K; REAL F,MI);
BEGIN INTEGER I; REAL X,Y;
FOR I←M TIL K DO
BEGIN
Y←ABS(J[I]);
IF DEBUG THEN
OUTSTR(CVS(I)&":"&CVF(F)&":"&CVF(IF F<0 THEN -Y ELSE Y)&CRLF);
IF POWER THEN Y←Y*Y;
Y←570*Y+DELY;
X←ABS(XFACT*(F-MINF))+DELX;
AIVECT(X,DELY);
AVECT(X,Y);
IF F>0 AND Y-DELY>12 THEN
BEGIN
AIVECT(X-4,Y-4); AVECT(X+4,Y-4);
END;
F←F+MF;
END;
END;
INTEGER PROCEDURE JS(REAL MI);
BEGIN INTEGER I,K; REAL J0,J1,J2,W;
K←I←IF MI<.0001 THEN 0 ELSE MI+7;
J[I+1]←J[I-1]←J2←0.0; J[I]←J1←.00001; W←2/MI;
WHILE I≥1 DO
BEGIN
J[I-1]←J0←I*W*J1-J2;
I←I-1; J2←J1; J1←J0;
END;
W←J[0]/2;
FOR I←2 STEP 2 UNTIL K DO W←W+J[I];
W←.5/W;
FOR I←0 TIL K DO J[I]←J[I]*W;
IF K>3 THEN K←K-3;
RETURN(K);
END;
PROCEDURE DPYFM(REAL MI);
BEGIN INTEGER I,K,M,MM,IX,LX; REAL S,F;
K←JS(MI);
IF III THEN DPYSET(DPYBUF)
ELSE
BEGIN
DPYBUF[1]←DPY1; DPYBUF[2]←DPY2;
DPYRESET(DPY);
END;
DPYBIG(1);
S←-1;
FOR I←1 TIL K DO
BEGIN
J[-I]←S*J[I]; S←-S;
END;
IF R≠0 THEN ISOHZ(-K,K,C-K*MF,MI)
ELSE
BEGIN
IX←-(M←(L-1)%2); MM←L-M;
FOR I←MM TIL K DO
BEGIN
J[IX]←J[IX]-J[-I]; IX←IX+1;
END;
ISOHZ(-MM+1,K,IF L MOD 2=0 THEN 0 ELSE MF/2,MI);
END;
M←2*(2+K*MF/C); F←C/2; LX←I←1;
WHILE I≤M AND LX<7 DO
BEGIN
S←(F-MINF)*XFACT+DELX; IF III THEN S←S-IIDEL;
IF S>512 THEN DONE;
AIVECT(S-CHRWIDTH,DELY-CHRHEIGHT); DPYSST("↑");
AIVECT(S-3*CHRWIDTH,DELY-2*CHRHEIGHT);
IF S>-512 THEN DPYSST(CASE LX OF ("0","C"," C","2C","4C","8C","16C"));
IF I=1 AND S>-512 THEN
BEGIN
AIVECT(S-3*CHRWIDTH,DELY-2*CHRHEIGHT);
DPYSST("_");
AIVECT(S-3*CHRWIDTH,DELY-3*CHRHEIGHT-6);
DPYSST("2");
END;
F←F+F; I←I+I; LX←LX+1;
END;
DPYBIG(3);
AIVECT(-350,-120+DELY); DPYSST("MODULATION INDEX="&CVF(MI));
IF III THEN DPYOUT(2) ELSE DPYOUT(1);
END;
SOUND←FALSE;
IF SOUND THEN INIT_PTY;
III←DPYTST=0;
SETFORMAT(5,3);
POWER←FALSE; IIDEL←10;
IF SOUND THEN BARF(TRUE);
WHILE TRUE DO
BEGIN
IF NOT DEBUG THEN DPYTYP(-430,5,1);
OUTSTR("STEP MODE?, ANSWER YES OR <blank>←");
STEP_MODE←(INCHWL LAND '137="Y");
OUTSTR(CRLF&"CARRIER←"); CMD←S←INCHWL; C←REALSCAN(S,I);
IF C≠0 THEN CMD←"MIN" ELSE C←SAVEC;
IF CMD="C" THEN
BEGIN I←LOP(CMD);
OUTSTR(CRLF&"CARRIER←"); S←INCHWL; C←REALSCAN(S,I);
END;
SAVEC←C;
IF CMD="M" THEN
BEGIN I←LOP(CMD);
OUTSTR("MOD FREQ←"); S←INCHWL; MF←REALSCAN(S,I);
END;
IF CMD="I" THEN
BEGIN I←LOP(CMD);
OUTSTR("INDEX1←"); S←INCHWL; MI1←REALSCAN(S,I);
OUTSTR("INDEX2←"); S←INCHWL; MI2←REALSCAN(S,I);
END;
IF CMD="N" THEN
BEGIN
OUTSTR("NUMBER OF INCREMENTS←"); S←INCHWL; NI←REALSCAN(S,I);
END;
W←(MI2-MI1)/NI; ZSAVE←MI1+1;
K←(MI1 MAX MI2)+4;
MAXF←C+K*MF;
MINF←0 MAX (C-K*MF);
DELTAF←MAXF-MINF; XFACT←1020/DELTAF;
L←(2.002*C)/MF;
BEAT←2*C-L*MF;
R←BEAT+.1; BEAT←BEAT MIN MF-BEAT; IF R=0 THEN BEAT←MF;
DPYSET(DPYBUF);
DPYBIG(5);
AIVECT(-500,-300+DELY); SETFORMAT(5,1);
DPYSST("CARRIER="&CVF(C)&" MODULATION="&CVF(MF));
SETFORMAT(5,3);
AIVECT(-350,-220+DELY); DPYSST("BEAT FREQUENCY="&CVF(BEAT));
IF III THEN DPYOUT(1);
DPY←DPYPARS; DPY1←DPYBUF[1]; DPY2←DPYBUF[2];
IF MI1≠MI2 THEN FOR Z←MI1 STEP W UNTIL MI2,MI2-W STEP -W UNTIL MI1 DO
BEGIN LABEL ASK;
IF ABS(MI2-Z)<.000001 THEN Z←MI2;
DPYFM(Z);
ZSAVE←Z;
IF INCHRS≠-1 OR STEP_MODE THEN
BEGIN
ASK:
OUTSTR("TYPE <cr> TO PROCEED, E<cr> TO EXIT,
S<cr> TO GET STEP="&(IF ¬STEP_MODE THEN "TRUE" ELSE "FALSE")&
(IF SOUND THEN ", P<cr> TO PLAY←" ELSE "←"));
IF (I←INCHWL LAND '137)="E" THEN GO TO NEXT_SET
ELSE IF I≠0 THEN
BEGIN
IF I="S" THEN STEP_MODE←NOT STEP_MODE
ELSE IF I="P" THEN
BEGIN
IF SOUND THEN PLAY1(Z);
END;
GO TO ASK;
END;
END;
END;
IF ABS(ZSAVE-MI1)>.001 THEN DPYFM(MI1);
NEXT_SET:
IF SOUND THEN
BEGIN
OUTSTR("PLAY SWEEP←");
IF (INCHWL LAND '137)="Y" THEN PLAY2;
END;
END;
END;;